dblogr/ Publications Academic agData Blog

COVID Origin Polls

Polling results from various polls on the origins of covid

Prepare Data

# devtools::install_github("derekmichaelwright/agData")
library(agData)
# Prep data
myCaption1 <- "www.dblogr.com/ or derekmichaelwright.github.io/dblogr/ | Data: Morning Consult"
d1 <- read.csv("data_morning_consult.csv") %>%
  mutate(Area = factor(Area, levels = rev(.$Area))) 
#
myCaption2 <- "derekmichaelwright.github.io/dblogr/ | Data: YouGov"
myTitle <- "35. COVID-19 Originated in Chinese Lab"
mySubtitle <- "Regardless of whether or not the virus responsible for COVID-19 was created or naturally mutated,\ndo you believe it is true or false that a laboratory in China was the origin of the virus?"
myAnswers <- c("Definatly false", "Propably false", "Not sure",
               "Probably true", "Definatly true")
d2 <- read.csv("data_yougov.csv", skip = 1, check.names = FALSE) %>%
  gather(Group, Percent, 2:ncol(.)) %>%
  mutate(Answer = factor(Answer, levels = myAnswers))

Morning Consult Poll

The share of adults who said the following comes closest to their opinion about the origins of the COVID-19 pandemic.

Surveys conducted March 14-April 2, 2023, among a representative sample of 2,200 U.S. adults and samples of roughly 1,000 adults in Australia and Latin American and European countries, with unweighted margins of error of +/- 2 and +/- 3 percentage points, respectively. Figures may not add up to 100% due to rounding.

# Prep data
myTraits <- c("Natural", "Unsure", "Lab Leak")
myColors <- c("darkred", "steelblue", "darkgreen")
yy <- d1 %>% 
  mutate(Natural.pos = Lab.Leak + Unsure,
         Lab.Leak.pos = Lab.Leak) 
xx <- d1 %>% gather(Trait, Value, 2:4) %>%
  mutate(Trait = gsub("\\."," ", Trait),
         Trait = factor(Trait, levels = myTraits))
# Plot
mp <- ggplot(xx, aes(x = Area)) +
  geom_col(aes(y = Value, fill = Trait), color = "black", alpha = 0.8)  +
  geom_text(data = yy, aes(y = Lab.Leak.pos, label = Lab.Leak), color = "white") +
  geom_text(data = yy, aes(y = Natural.pos, label = Natural), color = "white") +
  scale_fill_manual(name = NULL, values = myColors, breaks = rev(myTraits)) +
  scale_y_continuous(expand = c(0,0)) +
  theme_agData(legend.position = "bottom") +
  coord_flip() +
  labs(subtitle = "The share of adults who said the following comes closest
       /nto their opinion about the origins of the COVID-19 pandemic",
       x = NULL, y = "Percent", caption = myCaption1)
ggsave("covid_origin_1_01.png", mp, width = 6, height = 4)

YOUGOV Poll

35. COVID-19 Originated in Chinese Lab

March 4 - 7, 2023 - 1500 U.S. Adult Citizens

Regardless of whether or not the virus responsible for COVID-19 was created or naturally mutated, do you believe it is true or false that a laboratory in China was the origin of the virus?

All Data

# Prep data
myColors <- c("darkred", "palevioletred3","black", "steelblue", "darkblue")
myGroups <- c("Total", "Female",  "Male", "White", "Black", "Hispanic",
              "Ages 18-29", "Ages 30-44", "Ages 45-64", "Ages 65+",
              "Income < 50K", "Income 50-100K", "Income100K+",
              "Urban", "Suburban", "Rural",
              "Democrat", "Liberal", "Biden Voters",  
              "Independent", "Moderate",
              "Republican", "Conservative", "Trump Voters")
xx <- d2 %>% filter(Group %in% myGroups) %>%
  mutate(Group = factor(Group, levels = rev(myGroups))) %>%
  group_by(Group) %>%
  reframe(Answer = Answer, Percent = 100 * Percent / sum(Percent))
yy <- xx %>% filter(Answer %in% c("Definatly true", "Probably true")) %>%
  group_by(Group) %>%
  reframe(Percent = round(sum(Percent)))
# Plot
mp <- ggplot(xx, aes(x= Group, y = Percent)) +
  geom_col(aes(fill = Answer), color = "black", alpha = 0.7) +
  geom_text(data = yy, aes(label = Percent), color = "white") +
  scale_fill_manual(name = NULL, values = myColors) +
  scale_y_continuous(breaks = seq(0,100, by = 10), expand = c(0.01,0)) +
  coord_flip() + guides(fill = guide_legend(reverse=TRUE)) +
  theme_agData(legend.position = "bottom") +
  labs(title = myTitle, subtitle = mySubtitle, 
       x = NULL, caption = myCaption2)
ggsave("covid_origin_2_01.png", mp, width = 8, height = 6)

Ordered

# Prep data
myColors <- c("darkred", "palevioletred3","black", "steelblue", "darkblue")
myGroups <- c("Trump Voters", "Republican", "Conservative", "Ages 65+", 
               "Ages 45-64", "Rural", "White", "Income100K+", "Income 50-100K", 
               "Suburban", "Total", "Male", "Female", "Income < 50K", 
               "Independent", "Urban", "Ages 30-44", "Black", "Hispanic",   
               "Democrat", "Ages 18-29", "Biden Voters", "Liberal")
xx <- d2 %>% filter(Group %in% myGroups) %>%
  mutate(Group = factor(Group, levels = rev(myGroups))) %>%
  group_by(Group) %>%
  reframe(Answer = Answer, Percent = 100 * Percent / sum(Percent))
yy <- xx %>% filter(Answer %in% c("Definatly true", "Probably true")) %>%
  group_by(Group) %>%
  reframe(Percent = round(sum(Percent)))
# Plot
mp <- ggplot(xx, aes(x = Group, y = Percent)) +
  geom_col(aes(fill = Answer), color = "black", alpha = 0.7) +
  geom_text(data = yy, aes(label = Percent), color = "white") +
  scale_fill_manual(name = NULL, values = myColors) +
  scale_y_continuous(breaks = seq(0,100, by = 10), expand = c(0.01,0)) +
  coord_flip() + guides(fill = guide_legend(reverse=TRUE)) +
  theme_agData(legend.position = "bottom") +
  labs(title = myTitle, subtitle = mySubtitle, 
       x = NULL, caption = myCaption2)
ggsave("covid_origin_2_02.png", mp, width = 8, height = 6)

Bar Charts

# Create plotting function
plotPoll_1 <- function(xx = d2, myGroups, myColors, 
                       myTitle = "35. COVID-19 Originated in Chinese Lab",
                       mySubtitle = "Regardless of whether or not the virus responsible for COVID-19 was created or naturally mutated,\ndo you believe it is true or false that a laboratory in China was the origin of the virus?") {
  # Prep data
  xx <- xx %>% filter(Group %in% myGroups) %>%
    mutate(Group = factor(Group, levels = myGroups))
  # Plot
  ggplot(xx, aes(x = Answer, y = Percent, fill = Group)) +
    geom_col(position = "dodge", color = "black", alpha = 0.7) +
    scale_fill_manual(name = NULL, values = myColors) +
    theme_agData(legend.position = "bottom") +
    labs(title = myTitle, subtitle = mySubtitle, 
         x = NULL, caption = myCaption2)
}

Total

# Plot
mp <- plotPoll_1(myGroups = c("Female", "Total", "Male"), 
               myColors = c("palevioletred3", "darkblue", "steelblue"))
ggsave("covid_origin_3_01.png", mp, width = 7.5, height = 5)

Race

# Plot
mp <- plotPoll_1(myGroups = c("White", "Black", "Hispanic"), 
               myColors = c("grey80", "black", "darkgoldenrod2"))
ggsave("covid_origin_3_02.png", mp, width = 7.5, height = 5)

Age

# Plot
mp <- plotPoll_1(myGroups = c("Ages 18-29", "Ages 30-44", "Ages 45-64", "Ages 65+"), 
               myColors = c("steelblue", "darkblue", "darkred", "black"))
ggsave("covid_origin_3_03.png", mp, width = 7.5, height = 5)

Biden vs Trump

# Plot
mp <- plotPoll_1(myGroups = c("Biden Voters", "Trump Voters"), 
               myColors = c("darkblue", "darkred"))
ggsave("covid_origin_3_04.png", mp, width = 7.5, height = 5)

Ideology

# Plot
mp <- plotPoll_1(myGroups = c("Liberal", "Independent", "Conservative"), 
               myColors = c("darkblue", "steelblue", "darkred"))
ggsave("covid_origin_3_05.png", mp, width = 7.5, height = 5)

Pie

# Create plotting function
plotPoll_2 <- function(xx = d2, myGroups, 
                       myColors = c("darkred", "palevioletred3","black", "steelblue", "darkblue"), 
                       myTitle = "35. COVID-19 Originated in Chinese Lab",
                       mySubtitle = "Regardless of whether or not the virus responsible for COVID-19 was created or naturally mutated,\ndo you believe it is true or false that a laboratory in China was the origin of the virus?") {
  # Prep data
  xx <- xx %>% filter(Group %in% myGroups) %>%
    mutate(Group = factor(Group, levels = myGroups)) %>%
    group_by(Group) %>%
    summarise(Answer = Answer,
              Percent = 100 * Percent / sum(Percent))
  # Plot
  ggplot(xx, aes(x = 1, y = Percent, fill = Answer)) +
    geom_col(lwd = 0.2, color = "black", alpha = 0.7) +
    coord_polar("y", start = 0) +
    facet_grid(. ~ Group) +
    scale_fill_manual(name = NULL, values = myColors) +
    xlim(0.548, 1.45) +
    theme_agData_pie(legend.position = "bottom") +
    labs(title = myTitle, subtitle = mySubtitle, 
         x = NULL, caption = myCaption2)
}

Total

# Plot
mp <- plotPoll_2(myGroups = "Total")
ggsave("covid_origin_4_01.png", mp, width = 8, height = 8)

Race

# Plot
mp <- plotPoll_2(myGroups = c("White", "Black", "Hispanic"))
ggsave("covid_origin_4_02.png", mp, width = 7.5, height = 4)

Age

# Plot
mp <- plotPoll_2(myGroups = c("Ages 18-29", "Ages 30-44", "Ages 45-64", "Ages 65+"))
ggsave("covid_origin_4_03.png", mp, width = 7.5, height = 3.5)

Biden vs Trump

# Plot
mp <- plotPoll_2(myGroups = c("Biden Voters", "Trump Voters"))
ggsave("covid_origin_4_04.png", mp, width = 7.5, height = 5)

Ideology

# Plot
mp <- plotPoll_2(myGroups = c("Liberal", "Independent", "Conservative"))
ggsave("covid_origin_4_05.png", mp, width = 7.5, height = 4)

© Derek Michael Wright